home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 10 / BBS In A Box Volume X (AMUG) (January 1994).bin / Files / Prog / D-G / FutureBASIC 1.0 (ML).cpt / FutureBASIC 1.0 (ML) / Secs2Date+ Folder / _DateTimeRec.BAS next >
Encoding:
BASIC Source File  |  1992-10-15  |  6.3 KB  |  199 lines  |  [TEXT/ZBAS]
  1. ' Sample Source Code
  2. ' Michael Lininger, Lininger Technology, 1992
  3.  
  4. DIM myDateTime.DateTimeRecSize:                   ' This is my DateTimeRec Variable
  5.                                                   ' We take an image of the FB DateTimeRec equate as our own
  6.                                                   ' Make it GLOBAL so our LOCAL FN's have access to it
  7. END GLOBALS
  8.  
  9. CLEAR LOCAL
  10. LOCAL FN LTRIM$(work$)
  11.   
  12.   '   (c) Michael Lininger, Lininger Technology, 1992
  13.   '       Last Modified:  5/21/92
  14.   
  15.   ' Remove_Leading_Spaces - Strips a string variable of Leading spaces (&H0D)
  16.   
  17.   ' Variable: work$ is passed to the Function (string$)
  18.   ' Variable: work$ is returned by the Function (string$)
  19.   ' Variable: Exit% is used as a non_space flag (integer)
  20.   
  21.           Exit% = _false
  22.           DO
  23.     
  24.             LONG IF LEFT$(work$,1) =  " "
  25.               work$ = RIGHT$(work$,LEN(work$)-1)
  26.             XELSE
  27.               Exit% = _true
  28.             END IF
  29.     
  30.           UNTIL Exit% OR LEN(work$) < 1
  31.           
  32. END FN = work$
  33.  
  34.  
  35. CLEAR LOCAL
  36. LOCAL FN PadZero$(work$)
  37.   
  38.   '   (c) Michael Lininger, Lininger Technology, 1992
  39.   '       Last Modified:  5/21/92
  40.   
  41.   ' Pad_Leading_Zero - Adds leading 0 (Zero) for date format
  42.   
  43.   ' Variable: work$ is passed to the Function (string$)
  44.   ' Variable: work$ is returned by the Function (string$)
  45.   
  46.   IF LEN(work$) = 1 THEN work$ = "0" + work$
  47.   
  48. END FN = work$
  49.  
  50.  
  51. CLEAR LOCAL
  52. LOCAL FN FindDay$
  53.   
  54.   '   (c) Michael Lininger, Lininger Technology, 1992
  55.   '       Last Modified:  10/14/92
  56.   
  57.   ' Converts the numeric GLOBAL record.variable myDateTime.DayofWeek
  58.   ' into a descriptive string$ variable.
  59.   
  60.   ' Variable: myDateTime.DayofWeek part of the FB .DateTimeRec Equate
  61.   ' Variable: Dy$ holding variable for DayofWeek string$ description
  62.   
  63.   SELECT myDateTime.DayofWeek
  64.     CASE 1:Dy$="Sun"
  65.     CASE 2:Dy$="Mon"
  66.     CASE 3:Dy$="Tue"
  67.     CASE 4:Dy$="Wed"
  68.     CASE 5:Dy$="Thu"
  69.     CASE 6:Dy$="Fri"
  70.     CASE 7:Dy$="Sat"
  71.     CASE ELSE:Dy$="???":                          ' Martian Day
  72.   END SELECT
  73.   
  74. END FN = Dy$
  75.  
  76. CLEAR LOCAL
  77. LOCAL FN FindMonth$
  78.   
  79.   '   (c) Michael Lininger, Lininger Technology, 1992
  80.   '       Last Modified:  10/14/92
  81.   
  82.   ' Converts the numeric GLOBAL record.variable myDateTime.Month
  83.   ' into a descriptive string$ variable.
  84.   
  85.   ' Variable: myDateTime.Month part of the FB .DateTimeRec Equate
  86.   ' Variable: Mn$ holding variable for Month string$ description
  87.               
  88.   SELECT myDateTime.Month
  89.     CASE 1:Mn$ = "Jan"
  90.     CASE 2:Mn$ = "Feb"
  91.     CASE 3:Mn$ = "Mar"
  92.     CASE 4:Mn$ = "Apr"
  93.     CASE 5:Mn$ = "May"
  94.     CASE 6:Mn$ = "Jun"
  95.     CASE 7:Mn$ = "Jul"
  96.     CASE 8:Mn$ = "Aug"
  97.     CASE 9:Mn$ = "Sep"
  98.     CASE 10:Mn$ = "Oct"
  99.     CASE 11:Mn$ = "Nov"
  100.     CASE 12:Mn$ = "Dec"
  101.     CASE ELSE: Mn$= "???":                        ' Martian Month?
  102.   END SELECT
  103.   
  104. END FN = Mn$
  105.  
  106.  
  107. CLEAR LOCAL
  108. LOCAL FN DateToString$
  109.   
  110.   '   (c) Michael Lininger, Lininger Technology, 1992
  111.   '       Last Modified:  10/14/92
  112.   
  113.   ' Date_to_String - Converts DateTimeRec into a formatted date_time string$
  114.   
  115.   ' Variable: myDateTime.DateTimeRec GLOBAL
  116.   ' Variable: work$ is returned by the Function (string$)
  117.   ' Variable: amPM$ is work variable for AM or PM indicator
  118.   
  119.   ' determine if it is AM (day) or PM (night) - Lets not use Military Time
  120.   SELECT myDateTime.Hour
  121.     CASE 0
  122.       myDateTime.Hour = 12
  123.       amPM$ = "AM"
  124.     CASE < 12
  125.       amPM$ = "AM"
  126.     CASE 12
  127.       amPM$ = "PM"
  128.     CASE ELSE
  129.       amPM$ = "PM"
  130.       myDateTime.Hour = myDateTime.Hour - 12
  131.   END SELECT
  132.   
  133.   work$ = STR$(myDateTime.Year):  Year$ = FN LTRIM$(work$)
  134.   work$ = STR$(myDateTime.Month): work$ = FN LTRIM$(work$):MonthNum$ = FN PadZero$(work$)
  135.   work$ = STR$(myDateTime.Day):   work$ = FN LTRIM$(work$):Day$ =      FN PadZero$(work$)
  136.   work$ = STR$(myDateTime.Hour):  work$ = FN LTRIM$(work$):Hour$ =     FN PadZero$(work$)
  137.   work$ = STR$(myDateTime.Minute):work$ = FN LTRIM$(work$):Minute$ =   FN PadZero$(work$)
  138.   work$ = STR$(myDateTime.Second):work$ = FN LTRIM$(work$):Second$ =   FN PadZero$(work$)
  139.   MonthName$ = FN FindMonth$
  140.   DayofWeek$ = FN FindDay$
  141.   work$ = DayofWeek$+", " + MonthName$+" "+Day$+", "+Year$ +"    "+Hour$+":"+Minute$+":"+Second$+" "+amPM$
  142.   ' Other Style Format
  143.   ' work$ = MonthNum$+"/"+Day$+"/"+Year$+"    "+Hour$+":"+Minute$+":"+Second$
  144. END FN = work$
  145.  
  146.  
  147. WINDOW OFF:                                       'Close Default Window
  148. WINDOW #1:                                        'Open our own default window
  149. TEXT 0,12,0,0:                                    'System Font
  150.  
  151. PRINT
  152. PRINT " This is a sample Seconds to Date and"
  153. PRINT " Date to Seconds.          (ML 10/92)"
  154. PRINT
  155.  
  156. ' Convert Seconds to a full string$ Date/Time
  157. Address% = VAL("&H20C"):                          ' Memory Address for Seconds since 1904
  158. Today& = PEEK LONG(Address%):                     ' Get Todays Date/Time is Seconds since 1904
  159. CALL SECS2DATE(Today&,VARPTR(myDateTime))         ' Convert Seconds to Date Numerials
  160. work$ = FN DateToString$:                         ' Format myDateTime.DateTimeRec into a string$
  161. PRINT " Today is: ";TAB(20);work$:                ' Print it to Screen   
  162.  
  163. ' Convert a string Date/Time into Seconds
  164. ' This is useful for compacting date/time variables into
  165. ' a single 4_Byte variable.
  166.  
  167. workDate$ = "05/20/1992"
  168. workTime$ = "00:34:48"
  169. myDateTime.Year      = VAL(RIGHT$(workDate$,4))
  170. myDateTime.Month     = VAL(LEFT$(workDate$,2))
  171. myDateTime.Day       = VAL(MID$(workDate$,4,2))
  172. myDateTime.Hour      = VAL(LEFT$(workTime$,2))
  173. myDateTime.Minute    = VAL(MID$(workTime$,4,2))
  174. myDateTime.Second    = VAL(RIGHT$(workTime$,2))
  175. myDateTime.DayofWeek = 0:                         ' FN DATE2SECS will figure it for you
  176.  
  177. dateSeconds& = FN DATE2SECS(VARPTR(myDateTime))   ' Convert Date Numerials into Seconds
  178.  
  179. PRINT ""
  180. PRINT " Some past date in seconds..."
  181. PRINT ""
  182. PRINT " Seconds: ";TAB(20);dateSeconds&:          ' Print Signed Seconds to screen
  183.  
  184. ' Now lets check to make sure our dateSeconds& (4_Byte) variable
  185. ' converts back into the proper date.  Plus an added bonus, it
  186. ' will tell us the day of the week that date was on.
  187.  
  188. CALL SECS2DATE(dateSeconds&,VARPTR(myDateTime)):  ' Convert Seconds to Date Numerials
  189. work$ = FN DateToString$:                         ' Format myDateTime.DateTimeRec into a string$
  190. PRINT " Past Date: ";TAB(20);work$:               ' Print it to screen
  191. PRINT
  192. PRINT "Press Mouse Key to Quit..."
  193.  
  194. ' Wait till Mouse Button is pressed
  195. DO
  196. UNTIL FN BUTTON
  197. WINDOW CLOSE #1
  198. END 
  199.